unit Unit_SSL;

interface
  Uses
    Winapi.Windows, Winapi.WinSock, JwaWinCrypt, JwaSspi;

Type
  TSSL_Socket = Class(TObject)
    Private
      bConnected :Boolean;
      bUseSSL    :Boolean;
      hCreds     :CredHandle;
      hContext   :CtxtHandle;
    Protected
      hSocket :TSocket;
    Public
      Destructor Destroy; Override;
      Procedure Socket();
      Procedure Connect(pszAddress:PAnsiChar; wPort :DWORD);
      Procedure Disconnect();
      Function Send(Buffer :Pointer; iSize :Integer):Integer;
      Function Recv(Buffer :Pointer; iSize :Integer):Integer;
      Property Connected :Boolean Read bConnected;
      Property UseSSL :Boolean Read bUseSSL Write bUseSSL;
  End;

Const
  UNISP_NAME_A     :PAnsiChar = 'Microsoft Unified Security Protocol Provider';
  UNISP_NAME_W     :PWideChar = 'Microsoft Unified Security Protocol Provider';
  IO_BUFFER_SIZE   :DWORD     = $10000;
  SECPKG_ATTR_ISSUER_LIST_EX  = $59;
  SCHANNEL_CRED_VERSION       = $00000004;
  SCHANNEL_SHUTDOWN           = 1;
  SEC_E_OK                    = HRESULT($00000000);
  SEC_E_INTERNAL_ERROR        = HRESULT($80090304);
  SEC_I_CONTINUE_NEEDED       = HRESULT($00090312);
  SEC_E_INCOMPLETE_MESSAGE    = HRESULT($80090318);
  SEC_I_INCOMPLETE_CREDENTIALS= HRESULT($00090320);
  SEC_I_CONTEXT_EXPIRED       = HRESULT($00090317);
  SEC_I_RENEGOTIATE           = HRESULT($00090321);


Type
  PSecPkgContext_IssuerListInfoEx = ^SecPkgContext_IssuerListInfoEx;
  SecPkgContext_IssuerListInfoEx = Record
    aIssuers :PCERT_NAME_BLOB;
    cIssuers :DWORD;
  End;
  TSecPkgContext_IssuerListInfoEx = SecPkgContext_IssuerListInfoEx;
  
  ALG_ID = type Integer;

  SCHANNEL_CRED = record
    dwVersion: DWORD;
    cCreds: DWORD;
    paCred: PCCERT_CONTEXT;
    hRootStore: HCERTSTORE;
    cMappers: DWORD;
    aphMappers: Pointer;
    cSupportedAlgs: DWORD;
    palgSupportedAlgs: ^ALG_ID;
    grbitEnabledProtocols: DWORD;
    dwMinimumCipherStrength: DWORD;
    dwMaximumCipherStrength: DWORD;
    dwSessionLifespan: DWORD;
    dwFlags: DWORD;
    dwCredFormat: DWORD;
  end;
  
Var
  WSAData: TWSAData;

Function GetMemory(dwSize:DWORD):Pointer;
Procedure FreeMemory(lpMemory: Pointer);
Procedure RtlZeroMemory(Destination:Pointer; Length:DWORD); stdcall; external 'kernel32.dll' name 'RtlZeroMemory';
Procedure RtlMoveMemory(Destination:Pointer; Const Source:Pointer; Length:DWORD); stdcall; external 'kernel32.dll' name 'RtlMoveMemory';

implementation
Function GetMemory(dwSize:DWORD):Pointer;
begin
  Result := VirtualAlloc(Nil, dwSize, MEM_COMMIT Or MEM_RESERVE, PAGE_EXECUTE_READWRITE);
end;

Procedure FreeMemory(lpMemory: Pointer);
begin
  VirtualFree(lpMemory, 0, MEM_RELEASE);
end;

Function CheckMemory(pMemory:Pointer; dwSize:DWORD):Boolean;
begin
  Result := False;
  if pMemory = Nil then Exit;
  Result := (Not IsBadReadPtr(pMemory, dwSize)) And (Not IsBadWritePtr(pMemory, dwSize));
end;

Function Min(const A, B: Integer): Integer;
begin
  if A < B then
    Result := A
  else
    Result := B;
end;

Procedure GetNewClientCredentials(phCreds :PCredHandle; phContext :PCtxtHandle);
Var
	hCreds           :CredHandle;
	IssuerListInfo   :SecPkgContext_IssuerListInfoEx;
	pChainContext    :PCCERT_CHAIN_CONTEXT;
	FindByIssuerPara :CERT_CHAIN_FIND_BY_ISSUER_PARA;
	pCertContext     :PCCERT_CONTEXT;
	tsExpiry         :TimeStamp;
	Status           :SECURITY_STATUS;
  SchannelCred     :SCHANNEL_CRED;
begin
  Status := QueryContextAttributes(phContext, SECPKG_ATTR_ISSUER_LIST_EX, @IssuerListInfo);
  if Status = SEC_E_OK then
    Exit;

	RtlZeroMemory(@FindByIssuerPara, SizeOf(FindByIssuerPara));

	FindByIssuerPara.cbSize    := SizeOf(FindByIssuerPara);
	FindByIssuerPara.pszUsageIdentifier := szOID_PKIX_KP_CLIENT_AUTH;
	FindByIssuerPara.dwKeySpec := 0;
	FindByIssuerPara.cIssuer   := IssuerListInfo.cIssuers;
	FindByIssuerPara.rgIssuer  := IssuerListInfo.aIssuers;

	pChainContext := Nil;

  while True do
  begin
		pChainContext := CertFindChainInStore(Nil,
			X509_ASN_ENCODING,
			0,
			CERT_CHAIN_FIND_BY_ISSUER,
			@FindByIssuerPara,
			pChainContext);

    if pChainContext = Nil then
      Break;

    pCertContext := pChainContext^.rgpChain^.rgpElement^.pCertContext;
		SchannelCred.dwVersion := SCHANNEL_CRED_VERSION;
		SchannelCred.cCreds    := 1;
		SchannelCred.paCred    := @pCertContext;


		Status := AcquireCredentialsHandleA(
			Nil,                   // Name of principal
			PSecChar(UNISP_NAME_A),           // Name of package
			SECPKG_CRED_OUTBOUND,   // Flags indicating use
			Nil,                   // Pointer to logon ID
			@SchannelCred,          // Package specific data
			Nil,                   // Pointer to GetKey() func
			Nil,                   // Value to pass to GetKey()
			@hCreds,                // (out) Cred Handle
			tsExpiry);             // (out) Lifetime (optional)
    
    if (Status <> SEC_E_OK) Then
      Continue;

    FreeCredentialsHandle(phCreds);
    RtlMoveMemory(phCreds, @hCreds, SizeOf(CredHandle));
    //phCreds := @hCreds;
    
    Break;
  end;   
end;  

Function ClientHandshakeLoop(hSocket :TSocket; phCreds :PCredHandle; phContext :PCtxtHandle; fDoInitialRead :BOOL; pExtraData: PSecBuffer):SECURITY_STATUS;
Var
  InBuffer     :SecBufferDesc;
  InBuffers    :Array [0..1] Of SecBuffer;
  OutBuffer    :SecBufferDesc;
  OutBuffers   :Array [0..0] Of SecBuffer;
  dwFlags      :DWORD;
  dwOutFlags   :DWORD;
  tsExpiry     :TimeStamp;
  scRet        :SECURITY_STATUS;
  cbData       :Integer;

  IoBuffer     :PUCHAR;
  cbIoBuffer   :DWORD;
  fDoRead      :BOOL;

begin
	dwFlags := ISC_REQ_SEQUENCE_DETECT Or
		ISC_REQ_REPLAY_DETECT Or
		ISC_REQ_CONFIDENTIALITY Or
		ISC_RET_EXTENDED_ERROR Or
		ISC_REQ_ALLOCATE_MEMORY Or
		ISC_REQ_STREAM;

	IoBuffer := GetMemory(IO_BUFFER_SIZE);
  if IoBuffer = Nil then
    Exit(SEC_E_INTERNAL_ERROR);

  RtlZeroMemory(IoBuffer, IO_BUFFER_SIZE);
	cbIoBuffer := 0;
	fDoRead    := fDoInitialRead;

  scRet      := SEC_I_CONTINUE_NEEDED;

  while (scRet = SEC_I_CONTINUE_NEEDED) Or (scRet = SEC_E_INCOMPLETE_MESSAGE) Or (scRet = SEC_I_INCOMPLETE_CREDENTIALS) do
  begin
    if (0 = cbIoBuffer) Or (scRet = SEC_E_INCOMPLETE_MESSAGE) Then
    begin
      if fDoRead then
      begin
				cbData := Winapi.WinSock.recv(hSocket, PByte(DWORD(IoBuffer) + cbIoBuffer)^, IO_BUFFER_SIZE - cbIoBuffer, 0);
        if (cbData = SOCKET_ERROR) Then
        begin
          scRet := SEC_E_INTERNAL_ERROR;
          Break;
        end Else
        if (cbData = 0) Then
        begin
					scRet := SEC_E_INTERNAL_ERROR;
					Break;
        end;
        Inc(cbIoBuffer, cbData);
      end Else
      begin
        fDoRead := True;
      end;
    end;

		InBuffers[0].pvBuffer   := IoBuffer;
		InBuffers[0].cbBuffer   := cbIoBuffer;
		InBuffers[0].BufferType := SECBUFFER_TOKEN;

		InBuffers[1].pvBuffer   := Nil;
		InBuffers[1].cbBuffer   := 0;
		InBuffers[1].BufferType := SECBUFFER_EMPTY;

		InBuffer.cBuffers       := 2;
		InBuffer.pBuffers       := @InBuffers;
		InBuffer.ulVersion      := SECBUFFER_VERSION;

		OutBuffers[0].pvBuffer  := Nil;
		OutBuffers[0].BufferType:= SECBUFFER_TOKEN;
		OutBuffers[0].cbBuffer  := 0;

		OutBuffer.cBuffers      := 1;
		OutBuffer.pBuffers      := @OutBuffers;
		OutBuffer.ulVersion     := SECBUFFER_VERSION;

		scRet := InitializeSecurityContextA(phCreds,
			phContext,
			Nil,
			dwFlags,
			0,
			SECURITY_NATIVE_DREP,
			@InBuffer,
			0,
			Nil,
			@OutBuffer,
			dwOutFlags,
			@tsExpiry);

    if (scRet = SEC_E_OK) Or (scRet = SEC_I_CONTINUE_NEEDED) Or (Failed(scRet) And ((dwOutFlags And ISC_RET_EXTENDED_ERROR) = 1)) then
    begin
      if (OutBuffers[0].cbBuffer <> 0) And (OutBuffers[0].pvBuffer <> Nil) Then
      begin
				cbData := Winapi.WinSock.send(hSocket, PByte(OutBuffers[0].pvBuffer)^, OutBuffers[0].cbBuffer, 0);
        
        if (cbData = SOCKET_ERROR) Or (cbData = 0) then
        begin
					FreeContextBuffer(OutBuffers[0].pvBuffer);
					DeleteSecurityContext(phContext);
					Exit(SEC_E_INTERNAL_ERROR);
        end;  
        
				FreeContextBuffer(OutBuffers[0].pvBuffer);
				OutBuffers[0].pvBuffer := Nil;
      end;
    end;

    if (scRet = SEC_E_INCOMPLETE_MESSAGE) Then
      Continue;

    if (scRet = SEC_E_OK) Then
    begin
      if (InBuffers[1].BufferType = SECBUFFER_EXTRA) Then
      begin
        pExtraData^.pvBuffer := GetMemory(InBuffers[1].cbBuffer);
        if pExtraData^.pvBuffer = Nil then
        begin
          Exit(SEC_E_INTERNAL_ERROR);
        end;  

        RtlZeroMemory(pExtraData^.pvBuffer, InBuffers[1].cbBuffer);
        MoveMemory(pExtraData^.pvBuffer, Pointer(DWORD(IoBuffer) + (cbIoBuffer - InBuffers[1].cbBuffer)), InBuffers[1].cbBuffer);
        pExtraData^.cbBuffer   := InBuffers[1].cbBuffer;
				pExtraData^.BufferType := SECBUFFER_TOKEN;
      end Else
      begin
				pExtraData^.pvBuffer   := Nil;
				pExtraData^.cbBuffer   := 0;
				pExtraData^.BufferType := SECBUFFER_EMPTY;
      end; 
      Break;   
    end;

    if FAILED(scRet) Then
      Break;  

    if (scRet = SEC_I_INCOMPLETE_CREDENTIALS) Then
    begin
      GetNewClientCredentials(phCreds, phContext);
      fDoRead := False;
      scRet   := SEC_I_CONTINUE_NEEDED;
      Continue;
    end;  

    if InBuffers[1].BufferType = SECBUFFER_EXTRA then
    begin
			MoveMemory(IoBuffer, Pointer(DWORD(IoBuffer) + (cbIoBuffer - InBuffers[1].cbBuffer)), InBuffers[1].cbBuffer);
			cbIoBuffer := InBuffers[1].cbBuffer;
    end Else
    begin
      cbIoBuffer := 0;
    end;    
  end;

  if FAILED(scRet) Then
    DeleteSecurityContext(phContext);

	FreeMemory(IoBuffer);
	Result := scRet;
end;

Function PerformClientHandshake(hSocket :TSocket; phCreds :PCredHandle; pszServerName :PAnsiChar; phContext :PCtxtHandle; pExtraData: PSecBuffer):SECURITY_STATUS;
Var
  OutBuffer   :SecBufferDesc;
  OutBuffers  :Array [0..0] Of SecBuffer;
  dwFlags     :DWORD;
  dwOutFlags  :DWORD;
  tsExpiry    :TimeStamp;
  scRet       :SECURITY_STATUS;
  cbData      :Integer;
begin
	dwFlags := ISC_REQ_SEQUENCE_DETECT Or
		ISC_REQ_REPLAY_DETECT Or
		ISC_REQ_CONFIDENTIALITY Or
		ISC_RET_EXTENDED_ERROR Or
		ISC_REQ_ALLOCATE_MEMORY Or
		ISC_REQ_STREAM;

	OutBuffers[0].pvBuffer   := Nil;
	OutBuffers[0].BufferType := SECBUFFER_TOKEN;
	OutBuffers[0].cbBuffer   := 0;

	OutBuffer.cBuffers       := 1;
	OutBuffer.pBuffers       := @OutBuffers;
	OutBuffer.ulVersion      := SECBUFFER_VERSION;

	scRet := InitializeSecurityContextA(
		phCreds,
		Nil,
		PSecChar(pszServerName),
		dwFlags,
		0,
		SECURITY_NATIVE_DREP,
		Nil,
		0,
		phContext,
		@OutBuffer,
		dwOutFlags,
		@tsExpiry);

  if scRet <> SEC_I_CONTINUE_NEEDED then
    Exit(scRet);

  if (OutBuffers[0].cbBuffer <> 0) And (OutBuffers[0].pvBuffer <> Nil) Then
  begin
    cbData := Winapi.WinSock.send(hSocket, PByte(OutBuffers[0].pvBuffer)^, OutBuffers[0].cbBuffer, 0);
    if (cbData = SOCKET_ERROR) Or (cbData = 0) Then
    begin
      FreeContextBuffer(OutBuffers[0].pvBuffer);
      Exit(SEC_E_INTERNAL_ERROR);
    end;
    FreeContextBuffer(OutBuffers[0].pvBuffer);
    OutBuffers[0].pvBuffer := Nil;
  end;
  Result := ClientHandshakeLoop(hSocket, phCreds, phContext, True, pExtraData);
end;

Function DisconnectFromServer(hSocket :TSocket; phCreds :PCredHandle; phContext :PCtxtHandle):LONG;
Label Cleanup;
Var
	dwType           :DWORD;
	pbMessage        :PByte;
	cbMessage        :DWORD;
	cbData           :Integer;
	OutBuffer        :SecBufferDesc;
	OutBuffers       :Array [0..0] of  SecBuffer;
	dwFlags          :DWORD;
	dwOutFlags       :DWORD;
	tsExpiry         :TimeStamp;
	Status           :DWORD;
begin
	dwType := SCHANNEL_SHUTDOWN;

	OutBuffers[0].pvBuffer   := @dwType;
	OutBuffers[0].BufferType := SECBUFFER_TOKEN;
	OutBuffers[0].cbBuffer   := SizeOf(dwType);

	OutBuffer.cBuffers       := 1;
	OutBuffer.pBuffers       := @OutBuffers;
	OutBuffer.ulVersion      := SECBUFFER_VERSION;

	Status := ApplyControlToken(phContext, @OutBuffer);

  if FAILED(Status) Then
    Goto Cleanup;

	dwFlags := ISC_REQ_SEQUENCE_DETECT Or ISC_REQ_REPLAY_DETECT Or ISC_REQ_CONFIDENTIALITY Or ISC_RET_EXTENDED_ERROR Or
		ISC_REQ_ALLOCATE_MEMORY Or ISC_REQ_STREAM;

	OutBuffers[0].pvBuffer   := Nil;
	OutBuffers[0].BufferType := SECBUFFER_TOKEN;
	OutBuffers[0].cbBuffer   := 0;

	OutBuffer.cBuffers       := 1;
	OutBuffer.pBuffers       := @OutBuffers;
	OutBuffer.ulVersion      := SECBUFFER_VERSION;

	Status := InitializeSecurityContextA(phCreds, phContext, Nil, dwFlags, 0, SECURITY_NATIVE_DREP, Nil, 0, phContext,
		@OutBuffer, dwOutFlags, @tsExpiry);

  if FAILED(Status) Then
    Goto Cleanup;

	pbMessage := OutBuffers[0].pvBuffer;
	cbMessage := OutBuffers[0].cbBuffer;
  if (pbMessage <> Nil) And (cbMessage <> 0) Then
  begin
    cbData := Winapi.WinSock.send(hSocket, pbMessage^, cbMessage, 0);
    if (cbData = SOCKET_ERROR) Or (cbData = 0) Then
    begin
      Status := GetLastError;
      Goto Cleanup;
    end;
    FreeContextBuffer(pbMessage);
  end;

  Cleanup :
  begin
    DeleteSecurityContext(phContext);
    Result := Status;
  end;

end;

Procedure TSSL_Socket.Socket();
begin
  hSocket := Winapi.WinSock.Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
end;

Procedure TSSL_Socket.Connect(pszAddress:PAnsiChar; wPort :DWORD);
Var
  Address  :TSockAddrIn;
  szAddr   :Array [0..64] Of AnsiChar;
  HostEnt  :PHostEnt;

  tsExpiry :TimeStamp;
  Status   :SECURITY_STATUS;
  ExtraData:SecBuffer;
  SchannelCred  :SCHANNEL_CRED;
  StoredContext :PCCERT_CONTEXT;
Begin
  bConnected := False;

  if (hSocket = INVALID_SOCKET) Or (hSocket < 1) then
    Self.Socket;

  if (pszAddress = Nil) Or (lstrlenA(pszAddress) < 7) Or (wPort < 1) Or (wPort > 66535) then
    Exit;

  Address.sin_family        := AF_INET;
  Address.sin_port          := Winapi.WinSock.Htons(wPort);
  Address.sin_addr.s_addr   := Winapi.WinSock.Inet_Addr(pszAddress);
  if Address.sin_addr.s_addr = SOCKET_ERROR then
  Begin
    HostEnt   := Winapi.WinSock.gethostbyname(pszAddress);
    if HostEnt <> Nil then
    Begin
      RtlZeroMemory(@szAddr, SizeOf(szAddr));
      Winapi.Windows.wsprintfA(@szAddr, '%d.%d.%d.%d', Byte(PAnsiChar(HostEnt^.h_addr_list^)[0]), Byte(PAnsiChar(HostEnt^.h_addr_list^)[1]), Byte(PAnsiChar(HostEnt^.h_addr_list^)[2]), Byte(PAnsiChar(HostEnt^.h_addr_list^)[3]));
      Address.sin_addr.s_addr   := Winapi.WinSock.Inet_Addr(@szAddr);
      if Address.sin_addr.s_addr = SOCKET_ERROR then Exit;
    End Else Exit;
  End;
  If Winapi.WinSock.connect(hSocket, TSockAddr(Address), SizeOf(TSockAddr)) <> SOCKET_ERROR Then
  Begin
    bConnected := True;
    if bUseSSL then
    begin
      StoredContext          := Nil;
      RtlZeroMemory(@SchannelCred, SizeOf(SchannelCred));
      SchannelCred.dwVersion := SCHANNEL_CRED_VERSION;
      SchannelCred.cCreds    := 1;
      SchannelCred.paCred    := StoredContext;
      SchannelCred.grbitEnabledProtocols := SP_PROT_TLS1_2_CLIENT Or SP_PROT_TLS1_1_CLIENT Or SP_PROT_TLS1_0_CLIENT Or SP_PROT_SSL3_CLIENT;
      //指定协议 TLS1.0 1.1 1.2 SSL3
      Status := AcquireCredentialsHandleA(Nil, PSecChar(UNISP_NAME_A), SECPKG_CRED_OUTBOUND, Nil, @SchannelCred, Nil, Nil, @hCreds, tsExpiry);
      //Status := AcquireCredentialsHandleA(Nil, PSecChar(UNISP_NAME_A), SECPKG_CRED_OUTBOUND, Nil, Nil, Nil, Nil, @hCreds, tsExpiry);
      if Status <> SEC_E_OK then
      begin

      end;
      Status := PerformClientHandshake(hSocket, @hCreds, pszAddress, @hContext, @ExtraData);
      if Status <> SEC_E_OK then
      begin

      end;  
    end;
  End;
End;

Function TSSL_Socket.Send(Buffer :Pointer; iSize :Integer):Integer;
Var
  Sizes  :SecPkgContext_StreamSizes;
  Status :SECURITY_STATUS;
  iBytes :Integer;
  iRet   :Integer;

  cbIoBufferLength :DWORD;
  pbIoBuffer       :Pointer;
  pbMessage        :Pointer;
  Buffers          :Array [0..3] Of SecBuffer;
  iNowSize         :Integer;
  Message          :SecBufferDesc;

  iAllSize         :Integer;
  CurrentSended    :Integer;
begin
  Result := SOCKET_ERROR;
  if bConnected And (hSocket <> INVALID_SOCKET) then
  begin
    if Not bUseSSL then
    begin
      Result := Winapi.WinSock.send(hSocket, Buffer^, iSize, 0); 
    end Else
    begin
      iBytes := 0;
      Status := QueryContextAttributesA(@hContext, SECPKG_ATTR_STREAM_SIZES, @Sizes);
      if Status <> SEC_E_OK then
      begin

      end;
      cbIoBufferLength := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer;
      pbIoBuffer := GetMemory(cbIoBufferLength);
      if pbIoBuffer = Nil then
        Exit(SEC_E_INTERNAL_ERROR);

      pbMessage := Pointer(DWORD(pbIoBuffer) + Sizes.cbHeader);
      while True do
      begin
        iNowSize := Min(iSize - iBytes, Sizes.cbMaximumMessage);
        RtlMoveMemory(pbMessage, Pointer(DWORD(Buffer) + DWORD(iBytes)), iNowSize);

        Buffers[0].pvBuffer     := pbIoBuffer;
        Buffers[0].cbBuffer     := Sizes.cbHeader;
        Buffers[0].BufferType   := SECBUFFER_STREAM_HEADER;

        Buffers[1].pvBuffer     := pbMessage;
        Buffers[1].cbBuffer     := iNowSize;
        Buffers[1].BufferType   := SECBUFFER_DATA;

        Buffers[2].pvBuffer     := Pointer(DWORD(pbMessage) + DWORD(iSize));
        Buffers[2].cbBuffer     := Sizes.cbTrailer;
        Buffers[2].BufferType   := SECBUFFER_STREAM_TRAILER;

        Buffers[3].BufferType   := SECBUFFER_EMPTY;

        Message.ulVersion       := SECBUFFER_VERSION;
        Message.cBuffers        := 4;
        Message.pBuffers        := @Buffers;

        Status := EncryptMessage(@hContext, 0, @Message, 0);
        if Status <> SEC_E_OK then
        begin

        end;
        CurrentSended := 0;
        iAllSize := Buffers[0].cbBuffer + Buffers[1].cbBuffer + Buffers[2].cbBuffer;
        while True do
        begin
          iRet := Winapi.WinSock.send(hSocket, PByte(DWORD(pbIoBuffer) + DWORD(CurrentSended))^, iAllSize - CurrentSended, 0);
          if iRet = SOCKET_ERROR then
            Exit(SOCKET_ERROR);

          Inc(CurrentSended, iRet);

          if (CurrentSended >= iAllSize) then
            Break;
        end;
        iBytes := iNowSize;
        if iBytes >= iSize then
          Exit(iBytes);
      end;
    end;
  end;  
end;  

Function TSSL_Socket.Recv(Buffer :Pointer; iSize :Integer):Integer;
Var
  pSeek  :PByte;
  iBytes :Integer;
  dwError:Integer;
  iRet   :Integer;

  I      :Integer;
  Sizes  :SecPkgContext_StreamSizes;
  Status :SECURITY_STATUS;  
  cbIoBufferLength :DWORD;
  cbIoBuffer :Integer;
  pbIoBuffer :Pointer;
  //pbMessage  :PByte;

  Buffers    :Array [0..3] Of SecBuffer;
  Message    :SecBufferDesc;
  pfQOP      :DWORD;

  pDataBuffer :PSecBuffer;
  pExtraBuffer:PSecBuffer;

  ExtraData   :SecBuffer;
begin
  Result := SOCKET_ERROR;
  //iBytes := INVALID_SOCKET;
  if bConnected And (hSocket <> INVALID_SOCKET) then
  begin
    if Not bUseSSL then
    begin
      iBytes := iSize;
      pSeek  := Buffer;
      while iBytes > 0 do
      begin
        Result := Winapi.WinSock.recv(hSocket, pSeek^, iBytes, 0);
        
        if (Result <= 0) then 
          Break;
        
        Dec(iSize, Result);
        Inc(PByte(pSeek), Result);
      end;  
    end Else
    begin
      iBytes := 0;
      Status := QueryContextAttributesA(@hContext, SECPKG_ATTR_STREAM_SIZES, @Sizes);
      if Status <> SEC_E_OK then
      begin

      end;  

      cbIoBufferLength := Sizes.cbHeader + Sizes.cbMaximumMessage + Sizes.cbTrailer;
      pbIoBuffer := GetMemory(cbIoBufferLength);
      if pbIoBuffer = Nil then
        Exit(SEC_E_INTERNAL_ERROR);

      RtlZeroMemory(pbIoBuffer, cbIoBufferLength);
      cbIoBuffer:= 0;
      while True do
      begin
        if (0 = cbIoBuffer) Or (Status = SEC_E_INCOMPLETE_MESSAGE) Then
        begin
          iRet := Winapi.Winsock.recv(hSocket, PByte(DWORD(pbIoBuffer) + DWORD(cbIoBuffer))^, cbIoBufferLength - DWORD(cbIoBuffer), 0);
          if iRet = SOCKET_ERROR then
            Exit(SOCKET_ERROR);

          if iRet = 0 then
            Break;

          Inc(cbIoBuffer, iRet);
        end;

        RtlZeroMemory(@Buffers, SizeOf(Buffers));
        Buffers[0].pvBuffer     := pbIoBuffer;
        Buffers[0].cbBuffer     := cbIoBuffer;
        Buffers[0].BufferType   := SECBUFFER_DATA;
        Buffers[1].BufferType   := SECBUFFER_EMPTY;
        Buffers[2].BufferType   := SECBUFFER_EMPTY;
        Buffers[3].BufferType   := SECBUFFER_EMPTY;

        Message.ulVersion       := SECBUFFER_VERSION;
        Message.cBuffers        := 4;
        Message.pBuffers        := @Buffers;
        
        pfQOP  := 0;
        Status := DecryptMessage(@hContext, @Message, 0, pfQOP);

        if Status = SEC_E_INCOMPLETE_MESSAGE then
          Continue;

        if Status = SEC_I_CONTEXT_EXPIRED then
          Break;

        if (Status <> SEC_E_OK) And (Status <> SEC_I_RENEGOTIATE) And (Status <> SEC_I_CONTEXT_EXPIRED) then
          Exit(Status);

        pDataBuffer := Nil;
        pExtraBuffer:= Nil;;
        for I := 1 To 3 do
        begin
          if (pDataBuffer = Nil) And (Buffers[i].BufferType = SECBUFFER_DATA) Then
            pDataBuffer := @Buffers[i];

          if (pExtraBuffer = Nil) And (Buffers[i].BufferType = SECBUFFER_EXTRA) Then
            pExtraBuffer := @Buffers[i];
        end;

        if (pDataBuffer <> Nil) Then
        begin
          if (iSize < (iBytes + Integer(pDataBuffer^.cbBuffer))) Then
          begin
            RtlMoveMemory(Pointer(DWORD(Buffer) + DWORD(iBytes)), pDataBuffer^.pvBuffer, iSize - iBytes);
            Exit(iSize);
          end;
          RtlMoveMemory(Pointer(DWORD(Buffer) + DWORD(iBytes)), pDataBuffer^.pvBuffer, pDataBuffer^.cbBuffer);
          Inc(iBytes, pDataBuffer^.cbBuffer);
        end;

        if (pExtraBuffer <> Nil) Then
        begin
          RtlMoveMemory(pbIoBuffer, pExtraBuffer^.pvBuffer, pExtraBuffer^.cbBuffer);
          cbIoBuffer := pExtraBuffer^.cbBuffer;
        end Else
        begin
          cbIoBuffer := 0;
        end;

        if Status = SEC_I_RENEGOTIATE then
        begin
          Status := ClientHandshakeLoop(hSocket, @hCreds, @hContext, False, @ExtraData);
          if Status <> SEC_E_OK then
          begin

          end;

          if (ExtraData.pvBuffer <> Nil) Then
          begin
            RtlMoveMemory(pbIoBuffer, ExtraData.pvBuffer, ExtraData.cbBuffer);
            cbIoBuffer := ExtraData.cbBuffer;
          end;
        end;
      end;
    end;
    dwError:= GetLastError;
    if (dwError > 0) And (dwError <> 10035) then
      Exit;

    if iBytes <> INVALID_SOCKET  then
      Result := iSize - iBytes; 
  end;  
end;        
      
Procedure TSSL_Socket.Disconnect();
begin
  if hSocket <> INVALID_SOCKET then
  begin
    if bUseSSL then
      DisconnectFromServer(hSocket, @hCreds, @hContext);

    if bConnected then
      Winapi.WinSock.shutdown(hSocket, SD_BOTH);

    Winapi.WinSock.closesocket(hSocket)
  end;
end;

Destructor TSSL_Socket.Destroy;
begin
  Inherited Destroy;
end;

Initialization
  WSAStartUp(257, WSAData);

Finalization
  WSACleanup;
end.
